home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 8 / FM Towns Free Software Collection 8.iso / t_os / qkr_log / qkr_main.bas < prev    next >
BASIC Source File  |  1994-06-01  |  31KB  |  1,031 lines
  1. 1000 '***   ＱＫＲ無線ログ帳！        ***
  2. 1010 '***     FC用ダウンバージョン    ***
  3. 1020 '***  1994/01/30  BY 尋燐･ルナ   ***
  4. 1030 '***                             ***
  5. 1040 :
  6. 1050 DEFSTR A :DEFINT B-Z
  7. 1060 TEST=0   :'制作用
  8. 1070 RAM=0    :'RAMディスク対応へ(1)
  9. 1080 :
  10. 1090  GOSUB *初期化
  11. 1100  GOSUB *項目設定
  12. 1110 'GOSUB *比較     :'テスト用(2ファイルの比較)
  13. 1120  GOSUB *L_情報
  14. 1130  IF F THEN GOSUB *Ｆ制作 :GOTO 1120
  15. 1140  ON KEY(10) GOSUB *再生
  16. 1150  KEY(10) ON
  17. 1160  GOSUB *オープニング
  18. 1170  IF F THEN 1220
  19. 1180 *LOOP
  20. 1190  GOSUB *画面
  21. 1200  GOSUB *画面2
  22. 1210  GOSUB *コール
  23. 1220  GOSUB *Ｈ_ＲC 
  24. 1230  GOSUB *時計
  25. 1240  INTERVAL 5 :ON INTERVAL GOSUB *時計I :INTERVAL ON
  26. 1250  GOSUB *情報
  27. 1260  GOSUB *ＣＱ
  28. 1270  GOSUB *メニュー
  29. 1280  GOSUB *入力
  30. 1290 'GET@A (0,0)-(639,479),GAM :FG=1
  31. 1300  INTERVAL OFF
  32. 1310  IF INSTR(" 1 5 7 8",STR$(NO)) THEN GOSUB *Ｈ_Ｒ :WAIT 100
  33. 1320  COLOR 7 :WAIT 100
  34. 1330  ON NO GOTO *ME1,*ME2,*ME3,*ME4,*ME5,*ME6,*ME8,*ME9,*ME10
  35. 1340  *ME1 :GOSUB *続き入力 :GOTO *LOOP  :GOTO 4570
  36. 1350  *ME2 :GOSUB *検索     :GOTO *LOOP  :GOTO 5480
  37. 1360  *ME3 :GOSUB *リスト   :GOTO *LOOP
  38. 1370  *ME4 :GOSUB *月別     :GOTO *LOOP  :GOTO 9960
  39. 1380  *ME5 :GOSUB *B_UP     :GOTO *LOOP
  40. 1390 '*ME6 :GOSUB *チェンジ :GOTO *LOOP
  41. 1400  *ME6 :GOSUB *システム :GOTO *LOOP  :GOTO 10630
  42. 1410 '*ME7 :GOSUB *ソート   :GOTO *LOOP  :GOTO 6580
  43. 1420  *ME8 :GOSUB *録音     :GOTO *LOOP  :GOTO 9510
  44. 1430  *ME9 :GOSUB *終わり
  45. 1440 END
  46. 1450  *ME10: 'GOSUB *オプション :GOTO *LOOP
  47. 1460 :
  48. 1470 '----ＳＵＢ----
  49. 1480 *初期化
  50. 1490  SCREEN@ 0 :CLS :WIDTH 80,25 :PALETTE
  51. 1500  AT1="ＱＫＲ無線ログ帳！"   :'タイトル
  52. 1510  AT2="V3.2"                 :'バージョン
  53. 1520  AT3="1994/01/30"           :'制作日
  54. 1530 'ADH="E:\自作\"  :ADR="D:"  :'ドライブ
  55. 1540  ADH=""  :ADR=""            :'ドライブ--フリコレ用
  56. 1550  AF0="QKR_DATA.TXT"
  57. 1560  AF1="QKR_MAST.TXT"
  58. 1570  AF2="QKR_SORT.TXT"
  59. 1580  AF3="QKR_MAST.BUP"
  60. 1590  AF4="QKR_VOIC.PCM"
  61. 1600  AF5="QKR_SYST.TXT"
  62. 1610  AF6="１エリア.TXT"
  63. 1620  DIM AZ(5000,1)      :'データ読み込み数
  64. 1630  DIM AM(10)          :'情報(コール/開局/最終ログ･コール/声秒)
  65. 1640  FG=0                :'画面セーブ
  66. 1650 'DIM GAM(77000)      :'画面の退避
  67. 1660 RETURN
  68. 1670 :
  69. 1680 *項目設定
  70. 1690  W1C=8        :'##ウインド1の最大項目数
  71. 1700  DIM AW(W1C)  :'##項目名
  72. 1710  RESTORE *設定DATA :FOR I=1 TO W1C :READ AW(I) :NEXT
  73. 1720 RETURN
  74. 1730 :
  75. 1740 *設定DATA
  76. 1750  DATA "ログデータ の 入力"
  77. 1760  DATA "検索！"
  78. 1770  DATA "エリア･バンド別 局数リスト"
  79. 1780  DATA "月別のアクティブ度"
  80. 1790  DATA "バックアップ"
  81. 1800  DATA "システムの情報"
  82. 1810 'DATA "Hard - Ram システムチェンジ"
  83. 1820 'DATA "ソート ファイルの作成"
  84. 1830  DATA "録音しちゃうよ"
  85. 1840  DATA "－ 終了 －"
  86. 1850 :
  87. 1860 '----------------------------------------------------
  88. 1870 *画面
  89. 1880  IF FG=1 THEN CLS 4 :PUT@A (0,0)-(639,479),GAM :RETURN
  90. 1890  :SCREEN@ 0 :CLS :WIDTH 80,20
  91. 1900  PALETTE 9,[100,100,120]
  92. 1910  PALETTE 10,[180,180,180]
  93. 1920  PALETTE 11,[0,0,120]
  94. 1930 *画面1
  95. 1940  LINE (0,0)-(639,479),PSET,%9,BF,&H9090909009090909
  96. 1950 RETURN
  97. 1960 :
  98. 1970 *画面2
  99. 1980  SYMBOL (30,10),AT1,2,1,6,,,15
  100. 1990  SYMBOL (350,23),AT2,1,1,5,,,1,2
  101. 2000  SYMBOL (450,10),"ＨＩ－ＣＣＣ",1,1,4,,,7
  102. 2010  SYMBOL (450,30),"製作者: 尋燐･ルナ",1,1,4,,,1
  103. 2020  SYMBOL (340,5),AT3,1,1,2
  104. 2030  FOR I=0 TO 1
  105. 2040   LINE (20,I+40)-(435,I+40),PSET,%11
  106. 2050   LINE (20,I+44)-(435,I+44),PSET,%11
  107. 2060   CONNECT (435,I+5)-(405,I+60)-(620,I+60)-(610,I+50)-(610,I+70),%11
  108. 2070  NEXT
  109. 2080  IF RAM THEN A="ラムディスク対応" ELSE A="ラムディスク非対応"
  110. 2090  SYMBOL (450,460),A,1,1,,,,7 
  111. 2100 RETURN
  112. 2110 :
  113. 2120 *ウインド
  114. 2130  GOSUB *窓
  115. 2140  X=X+30 :X1=X1-140 :Y=Y-14 :Y1=Y+24
  116. 2150  LINE (X,Y)-(X1,Y1),PSET,%9,BF
  117. 2160  IF FG THEN RETURN
  118. 2170  GOSUB *窓
  119. 2180 RETURN
  120. 2190 :
  121. 2200 *メニュー  :'メイン窓
  122. 2210  X=50 :Y=82 :X1=350 :Y1=W1C*20+180  :'左上/右下
  123. 2220  X3=X :Y3=Y :X2=X+70 :Y2=Y1-25  :GOSUB *ウインド
  124. 2230  X0=X :Y0=Y
  125. 2240  SYMBOL (X2,Y2),"どれにしますか？",1,1,4
  126. 2250  SYMBOL (X0+20,Y0+5),"メ ニ ュ ー",1,1,4,,,5
  127. 2260   FOR I=1 TO W1C
  128. 2270    X0=60 :Y0=93+I*24 :X1=90 :Y1=90+(I+1)*24
  129. 2280     CONNECT (X0,Y1)-(X0,Y0)-(X1,Y0),%10
  130. 2290     CONNECT (X0,Y1)-(X1,Y1)-(X1,Y0),0
  131. 2300    X0=95 :Y0=93+I*24 :X1=340 :Y1=90+(I+1)*24
  132. 2310     CONNECT (X0,Y1)-(X0,Y0)-(X1,Y0),%10
  133. 2320     CONNECT (X0,Y1)-(X1,Y1)-(X1,Y0),0
  134. 2330    SYMBOL (X3+5,Y3+24*I+14),AKCNV$(STR$(I)),1,1,5
  135. 2340    SYMBOL (X3+55,Y3+24*I+14),AW(I),1,1,6
  136. 2350   NEXT
  137. 2360 RETURN
  138. 2370 :
  139. 2380 *入力
  140. 2390  WHILE INKEY$<>"" :WEND
  141. 2400  AM="＊入力してくださいね！尋燐・ルナ  " 
  142. 2410  IO=LEN(AM)/2 :AM=AM+AM
  143. 2420  A="" :I=1 :X2=X2+140
  144. 2430   WHILE A=""
  145. 2440    SYMBOL (X2,Y2),MID$(AM,I*2-1,8),1,1,%9
  146. 2450    I=I+1 :IF I>IO THEN I=1
  147. 2460    SYMBOL (X2,Y2),MID$(AM,I*2-1,8),1,1,%3
  148. 2470    WAIT 15
  149. 2480    A=INKEY$ 
  150. 2490   WEND
  151. 2500  IF A="O" OR A="o" THEN NO=10 :GOTO 2580
  152. 2510  NO=VAL(A)
  153. 2520  IF NO<1 OR NO>W1C THEN BEEP :A="" :GOTO 2430
  154. 2530  SYMBOL (X2,Y2),MID$(AM,I*2-1,8),1,1,%9
  155. 2540  SYMBOL (X2,Y2),AKCNV$(A)+"了解！",1,1,5,,,,1
  156. 2550  X0=95 :Y0=93+NO*24 :X1=340 :Y1=90+(NO+1)*24
  157. 2560   CONNECT (X0,Y1)-(X0,Y0)-(X1,Y0),0
  158. 2570   CONNECT (X0,Y1)-(X1,Y1)-(X1,Y0),%10
  159. 2580 RETURN
  160. 2590 :
  161. 2600 *時計
  162. 2610  TX=430 :TY=80 :TX1=620 :TY1=140
  163. 2620   X=430 : Y=80 : X1=620 : Y1=140
  164. 2630   GOSUB *窓
  165. 2640   GOSUB *時計S
  166. 2650 RETURN
  167. 2660 :
  168. 2670 *時計S
  169. 2680  ATD=DATE$ :ATT=LEFT$(TIME$,7)
  170. 2690  LINE (TX+50,TY+1)-(TX1-1,TY1-1),PSET,%9,BF
  171. 2700  SYMBOL (TX+10,TY+10),"日付: "+AKCNV$(ATD),1,1,5
  172. 2710  SYMBOL (TX+10,TY+33),"時刻: "+AKCNV$(ATT)+"０",1,1,5
  173. 2720 RETURN
  174. 2730 :
  175. 2740 *時計I
  176. 2750  IF ATD<>DATE$ THEN *時計S
  177. 2760  IF ATT<>LEFT$(TIME$,7) THEN *時計S
  178. 2770 RETURN
  179. 2780 :
  180. 2790 *コール
  181. 2800  IF FG THEN RETURN
  182. 2810  X=410 :Y=160 :X1=620 :Y1=215
  183. 2820   GOSUB *窓
  184. 2830 *コール1
  185. 2840   A=AM(1)
  186. 2850   SYMBOL (X+1,Y+10),A,2,1,%10,,,7
  187. 2860   SYMBOL (X+2,Y+11),A,2,1,%10,,,7
  188. 2870   SYMBOL (X+4,Y+13),A,2,1,4  ,,,7
  189. 2880   SYMBOL (X+3,Y+12),A,2,1,4  ,,,7
  190. 2890   SYMBOL (X+60,Y+34),"開局:"+AM(2),1,1,7
  191. 2900 RETURN
  192. 2910 :
  193. 2920 *終わり
  194. 2930  DIM LAS(5000)
  195. 2940  GET@A (400,150)-(630,225),LAS
  196. 2950  X=400 :X1=630 :Y=150 :Y1=75  :M=80  :M1=-2 :W=0 :GOSUB *Y移動
  197. 2960  X=400 :X1=630 :Y=70  :Y1=75  :M=330 :M1=2  :W=0 :GOSUB *Y移動
  198. 2970  X=400 :X1=630 :Y=400 :Y1=75  :M=10  :M1=-2 :W=1 :GOSUB *Y移動
  199. 2980  X=400 :X1=230 :Y=390 :Y1=465 :M=390 :M1=-2 :W=0 :GOSUB *X移動
  200. 2990  X=10  :X1=240 :Y=390 :Y1=75  :M=330 :M1=-2 :W=0 :GOSUB *Y移動
  201. 3000  X=10  :X1=240 :Y=60  :Y1=75  :M=20  :M1=2  :W=1 :GOSUB *Y移動 
  202. 3010  X=10  :X1=230 :Y=80  :Y1=155 :M=200 :M1=2  :W=0 :GOSUB *X移動
  203. 3020  X=210 :X1=440 :Y=80  :Y1=75  :M=220 :M1=2  :W=0 :GOSUB *Y移動
  204. 3030  SYMBOL (130,150),"ＣＬＯＳＥ",5,5,0
  205. 3040 RETURN
  206. 3050 :
  207. 3060 *X移動
  208. 3070  IF M1<0 THEN M=M*-1
  209. 3080  FOR I=X TO X+M STEP M1
  210. 3090    PUT@A (I,Y)-(I+X1,Y1),LAS
  211. 3100  NEXT
  212. 3110 RETURN
  213. 3120 :
  214. 3130 *Y移動
  215. 3140  IF M1<0 THEN M=M*-1
  216. 3150  FOR I=Y TO Y+M STEP M1
  217. 3160    PUT@A (X,I)-(X1,I+Y1),LAS
  218. 3170    IF W THEN WAIT 5
  219. 3180  NEXT
  220. 3190 RETURN
  221. 3200 :
  222. 3210 *情報
  223. 3220  X=420 :Y=230 :X1=610 :Y1=410
  224. 3230  GOSUB *窓
  225. 3240  X=X+10 :Y=Y+5 :X1=X+70 :Y1=Y+20
  226. 3250  GOSUB *裏窓
  227. 3260  X=X+15 :Y=Y+2
  228. 3270  SYMBOL (X,Y),"情 報",1,1,4
  229. 3280  X=430 :Y=210 :X1=600
  230. 3290  A="ログ ファイル名" :A1=ADH+AF1 :GOSUB *情報_S
  231. 3300  A="記録ログ数" :A1=AM(3) :GOSUB *情報_S
  232. 3310  A="最終記録ログ" :A1=LEFT$(AM(4)+SPACE$(20),20) :GOSUB *情報_S
  233. 3320 RETURN
  234. 3330 *情報_S
  235. 3340  Y=Y+50 :Y1=Y+45
  236. 3350  GOSUB *窓
  237. 3360  SYMBOL (X+25,Y+ 5),A ,1,1,7
  238. 3370  SYMBOL (X+ 5,Y+25),A1,1,1,6
  239. 3380 RETURN
  240. 3390 :
  241. 3400 *ＣＱ
  242. 3410  IF FG THEN RETURN
  243. 3420  X=150 :Y=400 :X1=390 :Y1=455
  244. 3430  GOSUB *窓
  245. 3440  X=X+10 :Y=Y+10
  246. 3450  SYMBOL (X,Y),"ＰＦ１０を押すと、",1,1,5
  247. 3460  SYMBOL (X+30,Y+20),"何時でもＣＱを出します。",1,1,5
  248. 3470 RETURN
  249. 3480 :
  250. 3490 *Ｈ_Ｒ
  251. 3500  X=20 :Y=400 :X1=135 :Y1=455
  252. 3510  GOSUB *窓
  253. 3520  X=X+10 :Y=Y+10
  254. 3530  SYMBOL (X,Y),"ＨＤ_ＯＮ！",1,2,6,,,7
  255. 3540  LINE (X,Y+35)-(X+90,Y+36),PSET,4,BF
  256. 3550 RETURN
  257. 3560 :
  258. 3570 *Ｈ_ＲC
  259. 3580  IF FG THEN RETURN
  260. 3590  X=20 :Y=400 :X1=135 :Y1=455
  261. 3600  GOSUB *窓
  262. 3610  X=X+10 :Y=Y+10
  263. 3620  SYMBOL (X,Y),"Sleep!ＨＤ",1,2,6,,,7
  264. 3630  LINE (X,Y+35)-(X+90,Y+36),PSET,4,BF
  265. 3640 RETURN
  266. 3650 :
  267. 3660 *C_窓
  268. 3670 *窓
  269. 3680  LINE (X,Y)-(X1,Y1),PSET,%9,BF
  270. 3690  CONNECT (X,Y1)-(X,Y)-(X1,Y),%10
  271. 3700  CONNECT (X-1,Y1)-(X-1,Y-1)-(X1+1,Y-1),%10
  272. 3710  CONNECT (X,Y1)-(X1,Y1)-(X1,Y),0
  273. 3720  CONNECT (X-1,Y1+1)-(X1+1,Y1+1)-(X1+1,Y-1),0
  274. 3730 RETURN
  275. 3740 :
  276. 3750 *裏窓
  277. 3760  CONNECT (X,Y1)-(X,Y)-(X1,Y),0
  278. 3770  CONNECT (X-1,Y1)-(X-1,Y-1)-(X1+1,Y-1),0
  279. 3780  CONNECT (X,Y1)-(X1,Y1)-(X1,Y),%10
  280. 3790  CONNECT (X-1,Y1+1)-(X1+1,Y1+1)-(X1+1,Y-1),%10
  281. 3800 RETURN
  282. 3810 :
  283. 3820 *S_窓
  284. 3830  X=60 :Y=82 :Y=Y+24*(NO+1)+12
  285. 3840  X1=380 :Y1=Y+160
  286. 3850  GOSUB *C_窓
  287. 3860 RETURN
  288. 3870 :
  289. 3880 *クリア
  290. 3890  LINE (0,50)-(400,400),PSET,%9,BF
  291. 3900 RETURN
  292. 3910 :
  293. 3920 '--------------
  294. 3930 *オープニング
  295. 3940  IF INKEY$<>"" THEN F=0 :RETURN ELSE F=1
  296. 3950  PALETTE 9,[0,0,0]
  297. 3960  PALETTE 6,[0,0,0]
  298. 3970  PALETTE 4,[0,0,0]
  299. 3980  GOSUB *画面1
  300. 3990  GOSUB *矢
  301. 4000  GOSUB *星
  302. 4010  CLS :PALETTE
  303. 4020  GOSUB *画面
  304. 4030  GOSUB *画面2
  305. 4040  IF INKEY$<>"" THEN F=0 :GOTO 4120
  306. 4050  GOSUB *矢移動
  307. 4060  GOSUB *開く
  308. 4070  GOSUB *コール1
  309. 4080  IF INKEY$<>"" THEN F=0 :GOTO 4120
  310. 4090  WAIT 100
  311. 4100  GOSUB *窓移動
  312. 4110  ERASE LAS
  313. 4120  ERASE YA,HOSI
  314. 4130 RETURN
  315. 4140 :
  316. 4150 *矢
  317. 4160  CONNECT (10,100)-(50,100)-(45,95)-(45,105)-(50,100),6
  318. 4170  CONNECT (10,100)-(5,95)-(15,95)-(20,100)-(15,105)-(5,105)-(10,100),4
  319. 4180  DIM YA(400)
  320. 4190  GET@A (1,95)-(51,105),YA
  321. 4200 RETURN
  322. 4210 :
  323. 4220 *星
  324. 4230  CONNECT (1,50)-(9,50)-(3,57)-(5,47)-(7,57)-(1,50),7
  325. 4240  DIM HOSI(100)
  326. 4250  GET@A (1,40)-(11,60),HOSI
  327. 4260 RETURN 
  328. 4270 :
  329. 4280 *矢移動
  330. 4290  Y=70
  331. 4300  FOR I=2 TO 700 STEP 2
  332. 4310    PUT@A (I,80)-(I+50,90),YA
  333. 4320    IF I<335 THEN Y=Y+1-1 :GOTO 4350
  334. 4330    PUT@A (315,Y)-(325,Y+20),HOSI
  335. 4340    IF I>450 THEN Y=Y+2
  336. 4350  NEXT
  337. 4360 RETURN
  338. 4370 :
  339. 4380 *開く
  340. 4390  FOR I=1 TO 105 
  341. 4400    X=320-I :X1=320+I
  342. 4410    Y=330-I :Y1=330+I
  343. 4420    IF Y <300 THEN Y =300 
  344. 4430    IF Y1>355 THEN Y1=355
  345. 4440    GOSUB *窓
  346. 4450  NEXT
  347. 4460 RETURN
  348. 4470 :
  349. 4480 *窓移動
  350. 4490  DIM LAS(5000)
  351. 4500  GET@A (200,290)-(430,365),LAS
  352. 4510 'GET@A (400,150)-(630,225),LAS
  353. 4520  X=200 :X1=430 :Y=290 :Y1=75  :M=140 :M1=-2 :W=0 :GOSUB *Y移動
  354. 4530  X=200 :X1=230 :Y=150 :Y1=225 :M=200 :M1=2  :W=0 :GOSUB *X移動
  355. 4540 RETURN
  356. 4550 :
  357. 4560 '------------------------------------------------------------------
  358. 4570 *続き入力
  359. 4580  CLS 
  360. 4590  PRINT "**  続き入力 **"
  361. 4600  PRINT ">最終入力チェック！"
  362. 4610  GOSUB *L_CHCK
  363. 4620  IF MAX=0 THEN A="XXXXXX 4F 94/07/28 .0.0.0" :PRINT ">新規作成"
  364. 4630  PRINT ">最終データ = "
  365. 4640  PRINT " "+A
  366. 4650  A0=""
  367. 4660   FOR I=20 TO 25
  368. 4670     A1=MID$(A,I,1) 
  369. 4680     IF A1="." THEN A1="0"
  370. 4690     A0=A0+A1
  371. 4700   NEXT
  372. 4710  NOTO=VAL(MID$(A0,1,2)) 
  373. 4720  PAJI=VAL(MID$(A0,3,2))
  374. 4730  RINE=VAL(MID$(A0,5,2))+1
  375. 4740  AYER=MID$(A,11,6)
  376. 4750  ADAY=MID$(A,17,2)
  377. 4760  PRINT 
  378. 4770  RESTORE 4770
  379. 4780   X=420 :Y=30
  380. 4790   READ A
  381. 4800    WHILE A<>"*"
  382. 4810     SYMBOL (X,Y),A,1,1,5
  383. 4820     READ A :Y=Y+20
  384. 4830    WEND
  385. 4840 :'--AF1/MAST  AF2/SORT
  386. 4850   OPEN "A",#1,ADH+AF1
  387. 4860   OPEN "A",#3,ADH+AF2
  388. 4870    IF RAM THEN OPEN "A",#2,ADR+AF1
  389. 4880    IF RAM THEN OPEN "A",#4,ADR+AF2
  390. 4890     GOSUB *入力1
  391. 4900    CLOSE
  392. 4910   CLOSE
  393. 4920  GOSUB *S_情報
  394. 4930 RETURN
  395. 4940 :DATA "日付入力時、＊を押すと","年／月を変更出来ます。",""
  396. 4950 :DATA "CALL入力時、Retを押すと","メニューに戻ります。","",""
  397. 4960 :DATA "－ バンド データ －"
  398. 4970 :DATA "４／４３０　　２／１４４","５／５０　　　１／２８"
  399. 4980 :DATA "６／２１　　　８／１４",  "７／７　　　　３／３.５",""
  400. 4990 :DATA "－ モード －"
  401. 5000 :DATA "0=FM  1=SSB  2=CW  3=AM","ret=0","*"
  402. 5010 :
  403. 5020 *入力1
  404. 5030  IF RINE>20 THEN RINE=1 :PAJI=PAJI+1
  405. 5040  PRINT "NOTO = ";NOTO :A=  RIGHT$(" "+STR$(NOTO),2)
  406. 5050  PRINT "PAJI = ";PAJI :A=A+RIGHT$(" "+STR$(PAJI),2)
  407. 5060  PRINT "RINE = ";RINE :A=A+RIGHT$(" "+STR$(RINE),2)
  408. 5070  A0="" :AV=""
  409. 5080   FOR I=1 TO 6
  410. 5090     A0=MID$(A,I,1)
  411. 5100     IF A0=" " THEN A0="."
  412. 5110     AV=AV+A0
  413. 5120   NEXT
  414. 5130  PRINT "-------";AV;"   ";AYER;ADAY
  415. 5140  GOTO 5170
  416. 5150  INPUT "年/月/ = ",A
  417. 5160   IF A="" THEN RETURN ELSE AYER=A
  418. 5170  INPUT "   日  = ",A
  419. 5180   IF A="E" THEN RETURN
  420. 5190   IF A="*" THEN 5150
  421. 5200   IF A<>"" THEN ADAY=RIGHT$("00"+A,2)
  422. 5210  LINE INPUT "CALL   = ",AC
  423. 5220   IF AC="" THEN RETURN
  424. 5230  INPUT "バンド = ",A
  425. 5240   IF A="" THEN *入力1
  426. 5250  INPUT "モード = ",A0
  427. 5260   A=A+A0
  428. 5270   IF A="" THEN *入力1
  429. 5280   A=LEFT$(A+"0",2)
  430. 5290   AW=LEFT$(A,1)
  431. 5300    IF RIGHT$(A,1)="0" THEN AW=AW+"F"
  432. 5310    IF RIGHT$(A,1)="1" THEN AW=AW+"S"
  433. 5320    IF RIGHT$(A,1)="2" THEN AW=AW+"C"
  434. 5330    IF RIGHT$(A,1)="3" THEN AW=AW+"A"
  435. 5340   A=AC+" "+AW+" "+AYER+ADAY+" "+AV :MAX=MAX+1
  436. 5350  LINE INPUT "適  用 = ",AT
  437. 5360   IF AT="" THEN 5380 
  438. 5370   A=A+" "+AT
  439. 5380  PRINT "========== ";A
  440. 5390  PRINT #1,A :PRINT #3,A
  441. 5400  IF RAM THEN PRINT #2,A :PRINT #4,A
  442. 5410  :AM(3)=STR$(MAX)+" "+AYER+ADAY+" "+AV
  443. 5420  :AM(4)=AC+" "+AW
  444. 5430  PRINT 
  445. 5440  RINE=RINE+1
  446. 5450 GOTO *入力1
  447. 5460 :
  448. 5470 '---------------------------------------------
  449. 5480 *検索
  450. 5490  CLS
  451. 5500  GOSUB *L_MAST  :'*L_SORT
  452. 5510  INPUT "***  検索  *** / CALL = ";A
  453. 5520  IF A="" THEN RETURN
  454. 5530  A=LEFT$(A+"******",6)
  455. 5540   FOR I=1 TO 6
  456. 5550     AA(I)=MID$(A,I,1)
  457. 5560   NEXT
  458. 5570  :
  459. 5580  AM="－－　"+AKCNV$(A)+"　－－"
  460. 5590  COLOR 5 :PRINT AM :COLOR 7
  461. 5600  CT=0
  462. 5610  FOR I=1 TO MAX
  463. 5620   A=AZ(I,0) :F=1
  464. 5630    FOR I0=1 TO 6
  465. 5640      IF AA(I0)="*" THEN 5660
  466. 5650      IF AA(I0)<>MID$(A,I0,1) THEN F=0
  467. 5660    NEXT
  468. 5670   IF F THEN CT=CT+1 :PRINT RIGHT$("   "+STR$(CT),4);"  ";AKCNV$(AZ(I,0))+AZ(I,1) ELSE 5690
  469. 5680   :IF (CT MOD 17)=0 THEN BEEP :COLOR 5 :PRINT AM+"                   WAIT!" :COLOR 7 :A=INPUT$(1)
  470. 5690   IF INKEY$<>"" THEN A=INPUT$(1)
  471. 5700  NEXT
  472. 5710  PRINT 
  473. 5720  PRINT "__該当データ数 ";CT;"個 でした。"
  474. 5730 :
  475. 5740 GOTO 5510
  476. 5750 :
  477. 5760 '------------------
  478. 5770 *L_MAST
  479. 5780  PRINT ">MAST DATA のロード"
  480. 5790  AF=AF1
  481. 5800  GOTO *LD
  482. 5810 *L_SORT
  483. 5820  PRINT ">SORT DATA のロード"
  484. 5830  AF=AF2
  485. 5840 *LD
  486. 5850  IF RAM THEN AF=ADR+AF ELSE AF=ADH+AF
  487. 5860 *D_LOAD
  488. 5870   OPEN "I",#1,AF
  489. 5880    I=0
  490. 5890     WHILE EOF(1)=0
  491. 5900       I=I+1
  492. 5910       INPUT #1,A
  493. 5920       IF A="" THEN I=I-1 :GOTO 5950
  494. 5930       AZ(I,0)=LEFT$(A,6) 
  495. 5940       AZ(I,1)=MID$(A,7) 
  496. 5950     WEND
  497. 5960   CLOSE
  498. 5970  MAX=I
  499. 5980 'PRINT ">データは ";MAX;"個有りました。  P_";(MAX \ 20)+1;" / ";(MAX MOD 20)
  500. 5990 RETURN
  501. 6000 :
  502. 6010 *L_CHCK
  503. 6020  OPEN "I",#1,ADH+AF1
  504. 6030  MAX=0
  505. 6040   WHILE EOF(1)=0
  506. 6050     MAX=MAX+1
  507. 6060     INPUT #1,A
  508. 6070   WEND
  509. 6080  CLOSE
  510. 6090  IF MAX=1AND A="" THEN MAX=0
  511. 6100 RETURN
  512. 6110 :
  513. 6120 *S_SORT
  514. 6130  PRINT ">Sort file SAVE"
  515. 6140   OPEN "A",#1,ADR+AF2
  516. 6150   OPEN "A",#2,ADH+AF2
  517. 6160   IF I0=1 THEN OPEN "A",#3,ADR+"JA1.TMP"
  518. 6170   IF I0=2 THEN OPEN "A",#3,ADR+"7XX.TMP"
  519. 6180    FOR I=1 TO MAX
  520. 6190     PRINT #1,AZ(I,0)+AZ(I,1)
  521. 6200     PRINT #2,AZ(I,0)+AZ(I,1)
  522. 6210     IF I0=1 OR I0=2 THEN PRINT #3,AZ(I,0)
  523. 6220    NEXT
  524. 6230   CLOSE
  525. 6240 RETURN
  526. 6250 :
  527. 6260 *L_情報
  528. 6270  LOCATE 0,16 :PRINT "＃＃　フリーソフト版　マイナーチェンジ　バージョン　＃＃"
  529. 6280  PRINT "＃＃　　ラムディスク対応・ソートファイルの削除　　　＃＃"
  530. 6290  PRINT "　　－　ＱＫＳ／ＢＶＺ／ＰＭＵ／ＴＤＶ／ＭＬＯ　－"
  531. 6300  PRINT "　　　　　　各局さんお元気ですか？"
  532. 6310  PRINT "　　　　　　又皆で遊びましょうネ。 from  ＱＫＲ" :PRINT 
  533. 6320  PRINT ">情報データ の読み込み。"
  534. 6330  A=ADR :F=0
  535. 6340  ON ERROR GOTO 6440
  536. 6350   OPEN "I",#1,A+AF0
  537. 6360     ON ERROR GOTO 0
  538. 6370     PRINT A;" ";
  539. 6380      FOR I=1 TO 10
  540. 6390       INPUT #1,AM(I) :PRINT ".";
  541. 6400      NEXT
  542. 6410   CLOSE
  543. 6420 PRINT RAM
  544. 6430 RETURN
  545. 6440 '--err
  546. 6450  IF ERL=6350 AND ERR=63 THEN F=1 :RESUME 6430
  547. 6460  PRINT ERR;ERL :STOP
  548. 6470 :
  549. 6480 *S_情報
  550. 6490  A=ADH :GOSUB *SS_情報
  551. 6500  IF RAM THEN A=ADR :GOSUB *SS_情報
  552. 6510 RETURN
  553. 6520 :
  554. 6530 *SS_情報
  555. 6540  A=A+AF0 :KILL A
  556. 6550  OPEN "O",#1,A
  557. 6560    FOR I=1 TO 10
  558. 6570     PRINT #1,AM(I)
  559. 6580    NEXT
  560. 6590  CLOSE
  561. 6600 RETURN
  562. 6610 :
  563. 6620 :
  564. 6630 '-------------------------------------
  565. 6640 *ソート
  566. 6650  CLS :COLOR 7
  567. 6660  PRINT "***   データをソートします。  ***"
  568. 6670  PRINT ">MAST DATA ファイルの オープン"
  569. 6680  PRINT ">12個の仮ファイルを作ります"
  570. 6690  GOSUB *仮ファイル
  571. 6700  PRINT ">データの振り分け"
  572. 6710  GOSUB *振り分け
  573. 6720  PRINT ">各エリア別ソート"
  574. 6730  RESTORE *仮ファイル
  575. 6740  KILL ADR+AF2 :KILL ADH+AF2
  576. 6750    FOR I0=1 TO 12 
  577. 6760      READ AF :AF=ADR+AF+".TMP" :MAX=0
  578. 6770      PRINT ">load :";AF;"   ...  ";
  579. 6780      GOSUB *D_LOAD :PRINT RIGHT$("     "+STR$(MAX),4);"   ";
  580. 6790     :IF MAX=0 THEN PRINT :GOTO 6840
  581. 6800      IF MAX=1 THEN 6830
  582. 6810      GOSUB *部分ソート2
  583. 6820      GOSUB *ダブり
  584. 6830      GOSUB *S_SORT
  585. 6840    NEXT
  586. 6850  GOSUB *簡易帳
  587. 6860  GOSUB *仮削除
  588. 6870  WAIT 200
  589. 6880 RETURN
  590. 6890 :
  591. 6900 *仮OUT
  592. 6910  OPEN "A",#2,ADR+A0+".TMP"
  593. 6920   PRINT #2,A
  594. 6930  CLOSE #2
  595. 6940 RETURN
  596. 6950 :
  597. 6960 *仮ファイル
  598. 6970  RESTORE 6970
  599. 6980   FOR I=1 TO 12
  600. 6990     READ A :A=ADR+A+".TMP" :PRINT "OPEN >";A
  601. 7000     OPEN "O",#1,A
  602. 7010     CLOSE
  603. 7020   NEXT
  604. 7030 RETURN
  605. 7040 DATA "X1","7X","X2","X3","X4","X5"
  606. 7050 DATA "X6","X7","X8","X9","X0","XX"
  607. 7060 :
  608. 7070 *仮削除
  609. 7080  RESTORE *仮ファイル
  610. 7090   FOR I=1 TO 12
  611. 7100     READ A :A=ADR+A+".TMP" :PRINT "KILL >";A
  612. 7110     KILL A
  613. 7120   NEXT
  614. 7130 RETURN
  615. 7140 :
  616. 7150 *簡易帳
  617. 7160  PRINT ">簡易リストを作成"
  618. 7170  KILL ADH+AF6
  619. 7180  OPEN "I",#1,ADR+"JA1.TMP"
  620. 7190  OPEN "I",#2,ADR+"7XX.TMP"
  621. 7200  OPEN "O",#3,ADH+AF6
  622. 7210   WHILE EOF(1)=0 OR EOF(2)=0
  623. 7220    A=""
  624. 7230    IF EOF(1) THEN A="        " :GOTO 7260
  625. 7240     INPUT #1,A0
  626. 7250     A=LEFT$(A0,6)+"  "
  627. 7260    IF EOF(2) THEN 7290
  628. 7270     INPUT #2,A0
  629. 7280     A=A+LEFT$(A0,6)
  630. 7290     A=AKCNV$(A)
  631. 7300    PRINT #3,A
  632. 7310   WEND
  633. 7320  CLOSE #1,#2,#3
  634. 7330  KILL ADR+"JA1.TMP"
  635. 7340  KILL ADR+"7XX.TMP"
  636. 7350 RETURN
  637. 7360 :
  638. 7370 *振り分け
  639. 7380  IF RAM THEN AF=ADR+AF2 ELSE AF=ADH+AF2
  640. 7390   OPEN "I",#1,AF
  641. 7400    I=0 :PRINT "start! :";
  642. 7410     WHILE EOF(1)=0
  643. 7420       I=I+1 :IF (I MOD 20)=0 THEN PRINT ".";
  644. 7430       INPUT #1,A
  645. 7440       A0=LEFT$(A,1)
  646. 7450       IF A0="7" THEN A0="7X" :GOSUB *仮OUT :GOTO 7500
  647. 7460       IF A0<>"8" AND A0<>"J" THEN 7490
  648. 7470       A0=MID$(A,3,1)
  649. 7480       IF A0>="0" AND A0<="9" THEN A0="X"+A0 :GOSUB *仮OUT :GOTO 7500
  650. 7490       A0="XX" :GOSUB *仮OUT
  651. 7500     WEND
  652. 7510   CLOSE
  653. 7520  PRINT "END : ";I
  654. 7530 RETURN
  655. 7540 :
  656. 7550 *部分ソート
  657. 7560  PRINT ">仮ソート中！    ";
  658. 7570   FOR I1=MAX-1 TO 1 STEP -1
  659. 7580    FOR I=1 TO I1
  660. 7590     IF AZ(I,0)>AZ(I+1,0) THEN SWAP AZ(I,0),AZ(I+1,0) :SWAP AZ(I,1),AZ(I+1,1)
  661. 7600    NEXT
  662. 7610   NEXT
  663. 7620 RETURN
  664. 7630 :
  665. 7640 *部分ソート2
  666. 7650  PRINT ">仮ソート中！    ";
  667. 7660  I1=1 :I2=MAX-1
  668. 7670   F=1
  669. 7680    FOR I=I1 TO I2
  670. 7690     IF AZ(I,0)>AZ(I+1,0) THEN SWAP AZ(I,0),AZ(I+1,0) :SWAP AZ(I,1),AZ(I+1,1) :F=0
  671. 7700    NEXT
  672. 7710  IF F THEN 7790
  673. 7720   F=1 :I2=I2-1 :IF I1>I2 THEN 7790
  674. 7730    FOR I=I2 TO I1 STEP -1
  675. 7740     IF AZ(I,0)>AZ(I+1,0) THEN SWAP AZ(I,0),AZ(I+1,0) :SWAP AZ(I,1),AZ(I+1,1) :F=0
  676. 7750    NEXT
  677. 7760  IF F THEN 7790
  678. 7770   F=1 :I1=I1+1 :IF I1>I2 THEN 7790
  679. 7780  GOTO 7680
  680. 7790 RETURN
  681. 7800 :
  682. 7810 *ダブり
  683. 7820 RETURN
  684. 7830 :
  685. 7840 '-------------------
  686. 7850 *B_UP
  687. 7860  GOSUB *S_窓  :X=X+10
  688. 7870  SYMBOL (X,Y+10),"**  データのバックアップをします。 **",1,1,7
  689. 7880  SYMBOL (X,Y+30),"対象はもちハードディスク！",1,1,7
  690. 7890  SYMBOL (X,Y+50),">宜しいですか？(Yes or Else)",1,1,7
  691. 7900  A=INPUT$(1)
  692. 7910  IF A<>"Y" AND A<>"y" THEN RETURN 
  693. 7920  SYMBOL (X,Y+70),"実行中！",1,1,%3
  694. 7930   OPEN "I",#1,ADH+AF1
  695. 7940    KILL ADH+AF3
  696. 7950    OPEN "O",#2,ADH+AF3
  697. 7960     I=0
  698. 7970      WHILE EOF(1)=0
  699. 7980        I=I+1
  700. 7990        INPUT #1,A
  701. 8000        PRINT #2,A
  702. 8010      WEND
  703. 8020    CLOSE
  704. 8030   CLOSE
  705. 8040  SYMBOL (X,Y+90),">データは "+STR$(I)+"個有りました。",1,1,5
  706. 8050  SYMBOL (X,Y+110),"> P_"+STR$((I \ 20)+1)+" / "+STR$((I MOD 20)),1,1,5
  707. 8060  SYMBOL (X,Y+130),"メインに戻ります。",1,1,7
  708. 8070  WAIT 300
  709. 8080 RETURN
  710. 8090 :
  711. 8100 *リスト
  712. 8110 'GOSUB *クリア
  713. 8120  X=20  :Y=60  :X1=X+220 :Y1=Y+385 :GOSUB *C_窓
  714. 8130  X=30  :Y=70  :X1=X+160 :Y1=Y+20  :GOSUB *裏窓
  715. 8140  SYMBOL (X+5,Y+2),"エリア別 局数リスト",1,1,4
  716. 8150  DIM CT(11),CB(99)
  717. 8160  IF RAM THEN A=ADR ELSE A=ADH
  718. 8170   OPEN "I",#1,A+AF1
  719. 8180    WHILE EOF(1)=0
  720. 8190     INPUT #1,A
  721. 8200      IF LEFT$(A,1)="7" THEN CT(10)=CT(10)+1 :GOTO 8240
  722. 8210      A0=MID$(A,3,1)
  723. 8220      IF A0<"0" AND A0>"9" THEN CT(11)=CT(11)+1 :GOTO 8240
  724. 8230      I=VAL(A0) :CT(I)=CT(I)+1
  725. 8240 : 
  726. 8250      I0=VAL(MID$(A,8,1))*10 :A0=MID$(A,9,1)
  727. 8260      IF A0="S" THEN I0=I0+1
  728. 8270      IF A0="C" THEN I0=I0+2
  729. 8280      IF A0="A" THEN I0=I0+3
  730. 8290      IF A0="F" THEN I0=I0+0
  731. 8300      CB(I0)=CB(I0)+1
  732. 8310    WEND
  733. 8320   CLOSE
  734. 8330 :
  735. 8340  RESTORE 8340
  736. 8350  X=X+10 :Y=Y+5 :I1=0
  737. 8360   FOR I=0 TO 11
  738. 8370     READ A,I0  :Y=Y+25
  739. 8380     X1=X+110 :Y1=Y+21
  740. 8390      CONNECT (X,Y1)-(X,Y)-(X1,Y),%10
  741. 8400      CONNECT (X,Y1)-(X1,Y1)-(X1,Y),0
  742. 8410      SYMBOL (X+20,Y+3),A+" エリア",1,1,7
  743. 8420     X0=X1+20 :X1=X0+60
  744. 8430      CONNECT (X0,Y1)-(X0,Y)-(X1,Y),%10
  745. 8440      CONNECT (X0,Y1)-(X1,Y1)-(X1,Y),0
  746. 8450      SYMBOL (X0+10,Y+3),RIGHT$("     "+STR$(CT(I0)),5),1,1,5
  747. 8460     I1=I1+CT(I0)
  748. 8470   NEXT
  749. 8480  X=X+25 :X1=X+165 :Y=Y+35 :Y1=Y+22 
  750. 8490  CONNECT (X,Y1)-(X,Y)-(X1,Y),%10
  751. 8500  CONNECT (X,Y1)-(X1,Y1)-(X1,Y),0
  752. 8510  SYMBOL (X+10,Y+3)," 合   計  ： "+RIGHT$("     "+STR$(I1),5),1,1,6
  753. 8520 :
  754. 8530 DATA "１",1,"_7",10,"２",2,"３",3,"４",4,"５",5,"６",6,"７",7,"８",8,"９",9,"０",0,"他",11
  755. 8540 :
  756. 8550 '------バンド別
  757. 8560  X=250 :Y=110 :X1=X+380 :Y1=Y+300 :GOSUB *C_窓
  758. 8570  X=260 :Y=120 :X1=X+160 :Y1=Y+20  :GOSUB *裏窓
  759. 8580  SYMBOL (X+5,Y+2),"バンド別 局数リスト",1,1,4
  760. 8590   FOR I=0 TO 90 STEP 10
  761. 8600     FOR I0=2 TO 7
  762. 8610       CB(I+8)=CB(I+8)+CB(I+I0)
  763. 8620     NEXT
  764. 8630    CB(I+9)=CB(I)+CB(I+1)+CB(I+8)
  765. 8640   NEXT
  766. 8650  :FOR I=0 TO 9
  767. 8660     FOR I0=10 TO 90 STEP 10
  768. 8670       CB(I)=CB(I)+CB(I0+I)
  769. 8680     NEXT
  770. 8690   NEXT
  771. 8700  X=X :Y=Y+30 :I1=0
  772. 8710   FOR I=0 TO 9
  773. 8720     X0=X :Y0=Y+I*25 :X1=X0+110 :Y1=Y0+21
  774. 8730      READ A :IF I=0 OR I=9 THEN 8770
  775. 8740      CONNECT (X0,Y1)-(X0,Y0)-(X1,Y0),%10
  776. 8750      CONNECT (X0,Y1)-(X1,Y1)-(X1,Y0),0
  777. 8760      SYMBOL (X0+5,Y0+3),A+" ＭＨｚ",1,1,7
  778. 8770    FOR I0=1 TO 3
  779. 8780      X0=X1+10 :X1=X0+50
  780. 8790      READ A
  781. 8800      IF I THEN I1=CB(VAL(A)) :A=RIGHT$("    "+STR$(I1),5)
  782. 8810      CONNECT (X0,Y1)-(X0,Y0)-(X1,Y0),%10
  783. 8820      CONNECT (X0,Y1)-(X1,Y1)-(X1,Y0),0
  784. 8830      SYMBOL (X0+5,Y0+3),A,1,1,7
  785. 8840    NEXT
  786. 8850      X0=X1+10 :X1=X0+60
  787. 8860      READ A
  788. 8870      IF I THEN I1=CB(VAL(A)) :A=RIGHT$("    "+STR$(I1),5)
  789. 8880      CONNECT (X0,Y1)-(X0,Y0)-(X1,Y0),%10
  790. 8890      CONNECT (X0,Y1)-(X1,Y1)-(X1,Y0),0
  791. 8900      SYMBOL (X0+10,Y0+3),A,1,1,7
  792. 8910  NEXT
  793. 8920 :
  794. 8930  ERASE CT,CB
  795. 8940  WHILE INKEY$<>"" :WEND :A=INPUT$(1)
  796. 8950 RETURN
  797. 8960 DATA "      ","ＦＭ"," SSB"," 他 "," 合計"
  798. 8970 DATA " ３.５",30,31,38,39
  799. 8980 DATA "    ７",70,71,78,79
  800. 8990 DATA "  １４",80,81,88,89
  801. 9000 DATA "  ２１",60,61,68,69
  802. 9010 DATA "  ２８",10,11,18,19
  803. 9020 DATA "  ５０",50,51,58,59
  804. 9030 DATA "１４４",20,21,28,29
  805. 9040 DATA "４３０",40,41,48,49
  806. 9050 DATA "      ", 0, 1, 8, 9
  807. 9060 :
  808. 9070 *チェンジ
  809. 9080  IF RAM THEN RETURN 
  810. 9090  GOSUB *S_窓  :X=X+10
  811. 9100  SYMBOL (X,Y+10),"***  ＲＡＭ　DISK  対応　 ***",1,1,7
  812. 9110  SYMBOL (X,Y+30),"データをＲＡＭディスクにコピーします。",1,1,7
  813. 9120  SYMBOL (X,Y+50),">宜しいですか？(Yes or Else)",1,1,7
  814. 9130  A=INPUT$(1)
  815. 9140   IF A<>"Y" AND A<>"y" THEN RETURN
  816. 9150  SYMBOL (X,Y+70),"実行中！",1,1,%3
  817. 9160   OPEN "I",#1,ADH+AF1
  818. 9170    ON ERROR GOTO 9450
  819. 9180    OPEN "O",#2,ADR+AF1
  820. 9190     ON ERROR GOTO 0
  821. 9200     I=0
  822. 9210       WHILE EOF(1)=0
  823. 9220        I=I+1
  824. 9230        INPUT #1,A
  825. 9240        PRINT #2,A
  826. 9250      WEND
  827. 9260    CLOSE
  828. 9270   CLOSE
  829. 9280 :
  830. 9290   OPEN "I",#1,ADH+AF0
  831. 9300    ON ERROR GOTO 9450
  832. 9310    OPEN "O",#2,ADR+AF0
  833. 9320     ON ERROR GOTO 0
  834. 9330       FOR I1=1 TO 10
  835. 9340        INPUT #1,A
  836. 9350        PRINT #2,A
  837. 9360       NEXT
  838. 9370    CLOSE 
  839. 9380   CLOSE
  840. 9390  SYMBOL (X,Y+90),">データは "+STR$(I)+"個有りました。",1,1,5
  841. 9400  SYMBOL (X,Y+110),"> P_"+STR$((I \ 20)+1)+" / "+STR$((I MOD 20)),1,1,5
  842. 9410  SYMBOL (X,Y+130),"メインに戻ります。(ret.)",1,1,7
  843. 9420  WAIT 200 :RAM=1
  844. 9430 RETURN
  845. 9440 :
  846. 9450 '--err
  847. 9460  IF ERL=9180 AND ERR=64 THEN KILL ADR+AF1 :RESUME
  848. 9470  IF ERL=9310 AND ERR=64 THEN KILL ADR+AF0 :RESUME
  849. 9480 PRINT ERR;"  ";ERL
  850. 9490 END
  851. 9500 :
  852. 9510 *録音
  853. 9520  CLS 4
  854. 9530  GOSUB *S_窓  :X=X+10
  855. 9540  SYMBOL (X,Y+10),"***  ＣＱマシーン用 データ作成  ***",1,1,7
  856. 9550  SYMBOL (X,Y+30),"音声を録音します。",1,1,7
  857. 9560  SYMBOL (X,Y+50),">宜しいですか？(Yes or Else)",1,1,7
  858. 9570  A=INPUT$(1)
  859. 9580   IF A<>"Y" AND A<>"y" THEN RETURN
  860. 9590  SYMBOL (X,Y+73),"録音時間は？(1-30秒)",1,1,7
  861. 9600  LOCATE 31,16 :INPUT "",A :L=VAL(A)/2
  862. 9610  IF L=0 THEN RETURN 
  863. 9620  DIM SAMP%(10000*L+32)
  864. 9630  WAIT 200 :SYMBOL (X,Y+95),"・録音 START!",1,1,6
  865. 9640  PCMREC SAMP%,10000
  866. 9650  SYMBOL (X+110,Y+95),"・終了",1,1,5
  867. 9660  WAIT 200 :SYMBOL (X+160,Y+95),"・再生",1,1,4
  868. 9670  PCMPLAY SAMP%,100
  869. 9680  WAIT L*200
  870. 9690  SYMBOL (X,Y+115),"Y.OK!  N.やり直し  R.再生  Ret.中止",1,1,7
  871. 9700  SYMBOL (X,Y+135),">どーれかなっ？",1,1,7
  872. 9710  A=INPUT$(1)
  873. 9720  IF A="R" OR A="r" THEN 9660
  874. 9730  IF A="N" OR A="n" THEN ERASE SAMP :GOTO *録音
  875. 9740  IF A="Y" OR A="y" THEN GOSUB *S_音声 :AM(5)=STR$(L) :GOSUB *S_情報
  876. 9750  ERASE SAMP
  877. 9760 RETURN
  878. 9770 *S_音声
  879. 9780  ON ERROR GOTO 9830
  880. 9790  SAVE@ ADH+AF4,SAMP%
  881. 9800  IF RAM THEN SAVE@ ADR+AF4,SAMP%
  882. 9810  ON ERROR GOTO 0
  883. 9820 RETURN
  884. 9830 '--ERR
  885. 9840  IF ERL=9790 AND ERR=64 THEN KILL ADH+AF4 :RESUME
  886. 9850  IF ERL=9800 AND ERR=64 THEN KILL ADR+AF4 :RESUME
  887. 9860 PRINT ERL;"  ";ERR :STOP
  888. 9870 :
  889. 9880 *再生
  890. 9890  IF VAL(AM(5))=0 THEN BEEP :RETURN
  891. 9900  DIM SAMP%(10000*VAL(AM(5))+32)
  892. 9910  IF RAM THEN LOAD@ ADR+AF4,SAMP% ELSE LOAD@ ADH+AF4,SAMP%
  893. 9920  PCMPLAY SAMP%,100
  894. 9930  ERASE SAMP
  895. 9940 RETURN
  896. 9950 :
  897. 9960 *月別
  898. 9970  X=110  :Y=75    :X1=X+350 :Y1=Y+280 :GOSUB *C_窓  :'月別
  899. 9980  X= 40  :Y=Y+285 :X1=X+420 :Y1=Y+100 :GOSUB *C_窓  :'比率
  900. 9990  X=120  :Y=85    :X1=X+140 :Y1=Y+20  :GOSUB *裏窓
  901. 10000  SYMBOL (X+5,Y+2),"月別 局数リスト",1,1,4
  902. 10010  SYMBOL (X+200,Y+2),"- 過去２年分 -",1,1,7
  903. 10020  X=X+20 :Y=Y+230
  904. 10030  CONNECT (X,Y-200)-(X,Y)-(X+300,Y),7
  905. 10040   FOR I=20 TO 80 STEP 20
  906. 10050    LINE (X+1,Y-I*2-1)-(X+300,Y-I*2-1),PSET,%1
  907. 10060    SYMBOL (X-30,Y-I*2-9),STR$(I),1,1,4
  908. 10070   NEXT
  909. 10080  LINE (X,Y+81)-(X+300,Y+81),PSET,%1
  910. 10090  LINE (X,Y+60)-(X+300,Y+60),PSET,%1
  911. 10100  SYMBOL (X-90,Y+63),"0エリア比率",1,1,6
  912. 10110  LINE (X,Y+106)-(X+300,Y+106),PSET,%1
  913. 10120  LINE (X,Y+85)-(X+300,Y+85),PSET,%1
  914. 10130  SYMBOL (X-90,Y+88),"144MHz比率",1,1,6
  915. 10140  LINE (X,Y+131)-(X+300,Y+131),PSET,%1
  916. 10150  LINE (X,Y+110)-(X+300,Y+110),PSET,%1
  917. 10160  SYMBOL (X-90,Y+113),"430MHz比率",1,1,6
  918. 10170 :
  919. 10180  DIM TU(500),TZ(500),T14(500),T43(500)  :'月/0エリア/144/430
  920. 10190  IF RAM THEN A=ADR ELSE A=ADH
  921. 10200   OPEN "I",#1,A+AF1
  922. 10210    WHILE EOF(1)=0
  923. 10220     INPUT #1,A
  924. 10230     I=(VAL(MID$(A,11,2))-93)*12+VAL(MID$(A,14,2))
  925. 10240     TU(I)=TU(I)+1
  926. 10250     IF MID$(A,3,1)="0" THEN TZ(I)=TZ(I)+1
  927. 10260     IF MID$(A,8,1)="2" THEN T14(I)=T14(I)+1 :GOTO 10280
  928. 10270     IF MID$(A,8,1)="4" THEN T43(I)=T43(I)+1
  929. 10280    WEND
  930. 10290   CLOSE
  931. 10300 :
  932. 10310  I2=(VAL(MID$(DATE$,1,2))-93)*12+VAL(MID$(DATE$,4,2))
  933. 10320  I1=I2-24 :IF I1<1 THEN I1=1
  934. 10330   FOR I=I1 TO I2
  935. 10340    IF TU(I)=0 THEN 10360
  936. 10350    LINE (X+I*10,Y-1)-(X+I*10+8,Y-1-TU(I)*2),PSET,5,BF
  937. 10360    IF (I MOD 12)=1 THEN SYMBOL (X+I*10,Y+4),"1",1,1,6 :SYMBOL (X+I*10-8,Y+21),STR$(((I-1) \ 12)+93),1,1,6
  938. 10370    IF (I MOD 12)=5 THEN SYMBOL (X+I*10,Y+4),"5",1,1,6
  939. 10380    IF (I MOD 12)=9 THEN SYMBOL (X+I*10,Y+4),"9",1,1,6
  940. 10390 : IF TU(I)=0 THEN 10440
  941. 10400    IF T14(I)+T43(I)>TU(I) THEN STOP :'err!
  942. 10410    LINE (X+I*10,Y+ 80)-(X+I*10+8,Y+80 -TZ(I) /TU(I)*20),PSET,5,BF
  943. 10420    LINE (X+I*10,Y+105)-(X+I*10+8,Y+105-T14(I)/TU(I)*20),PSET,5,BF
  944. 10430    LINE (X+I*10,Y+130)-(X+I*10+8,Y+130-T43(I)/TU(I)*20),PSET,5,BF
  945. 10440   NEXT
  946. 10450  WHILE INKEY$<>"" :WEND :A=INPUT$(1)
  947. 10460  ERASE TU,TZ,T14,T43
  948. 10470 RETURN
  949. 10480 :
  950. 10490 *比較
  951. 10500 CLS :PRINT "-- 比較 --"
  952. 10510 OPEN "I",#1,ADR+"PP.TXT"
  953. 10520  OPEN "I",#2,ADR+"QKR_SORT.TXT"
  954. 10530   WHILE EOF(1)=0
  955. 10540    INPUT #1,A
  956. 10550    INPUT #2,A0
  957. 10560    IF A<>A0 THEN PRINT A :PRINT A0
  958. 10570   WEND
  959. 10580  CLOSE
  960. 10590 CLOSE
  961. 10600 PRINT "** 終了 **"
  962. 10610 END
  963. 10620 :
  964. 10630 *システム
  965. 10640  IF RAM THEN AF=ADR+AF5 ELSE AF=ADH+AF5
  966. 10650   OPEN "I",#1,AF
  967. 10660    LINE INPUT #1,A
  968. 10670     WHILE A<>"END"
  969. 10680      GOSUB 10830
  970. 10690      X1=X :Y1=Y
  971. 10700      WHILE A<>"*"
  972. 10710       SYMBOL (X1,Y1),A,1,1,7
  973. 10720       Y1=Y1+20
  974. 10730       LINE INPUT #1,A
  975. 10740      WEND
  976. 10750     WAIT 100
  977. 10760     SYMBOL (X+120,Y+215),"何かキーを押して下さい。",1,1,5
  978. 10770     WHILE INKEY$="" :WEND
  979. 10780     LINE INPUT #1,A
  980. 10790    WEND
  981. 10800   CLOSE
  982. 10810 RETURN
  983. 10820 :
  984. 10830 '--sub
  985. 10840  X=150  :Y=90   :X1=X+350 :Y1=Y+280 :GOSUB *C_窓  :'月別
  986. 10850  X=X+10 :Y=Y+10 :X1=X+130 :Y1=Y+20  :GOSUB *裏窓
  987. 10860  SYMBOL (X+5,Y+2),"システムの情報",1,1,4
  988. 10870  X=X+20 :Y=Y+30
  989. 10880 RETURN
  990. 10890 :
  991. 10900 *Ｆ制作
  992. 10910  WAIT 200 :BEEP :CLS
  993. 10920  PRINT "＃＃　　ＱＫＲ無線ログ帳！　　＃＃"
  994. 10930  PRINT :PRINT ">'QKR_DATA.TXT'のファイルが見当たりません。"
  995. 10940  PRINT ">ディレクトリの移動、ファイルの存在を確認してください。"
  996. 10950  WAIT 200 :PRINT 
  997. 10960  PRINT ">もしかして新規作成ですか？(Yes or Else)_";
  998. 10970  A=INPUT$(1)
  999. 10980  IF A="Y" OR A="y" THEN PRINT "Yes!" ELSE PRINT "NO!" :PRINT "終了致します。" :END
  1000. 10990 'ファイルを作る
  1001. 11000  PRINT "MAKE FILE '";AF1;"'"
  1002. 11010   OPEN "O",#1,ADH+AF1
  1003. 11020   CLOSE
  1004. 11030  PRINT "MAKE FILE '";AF3;"'"
  1005. 11040   OPEN "O",#1,ADH+AF3
  1006. 11050   CLOSE
  1007. 11060  PRINT "MAKE FILE '";AF4;"'"
  1008. 11070   OPEN "O",#1,ADH+AF4
  1009. 11080   CLOSE
  1010. 11090  PRINT "MAKE FILE '";AF0;"'"
  1011. 11100   OPEN "O",#1,ADH+AF0
  1012. 11110    INPUT ">貴方のコールサインは？(大文字で)＿",A
  1013. 11120    A=AKCNV$(LEFT$(A+"  ",6))
  1014. 11130    PRINT #1,A
  1015. 11140    INPUT ">  〃  開局日は？(93/02/23)＿",A
  1016. 11150    PRINT #1,A
  1017. 11160    PRINT #1,"新規"
  1018. 11170    PRINT #1,"データ無し"
  1019. 11180    PRINT #1,0
  1020. 11190    PRINT #1,"予備"
  1021. 11200    PRINT #1,"予備"
  1022. 11210    INPUT ">  〃  ＪＣＣ／ＪＣＧは？＿",A
  1023. 11220    PRINT #1,A
  1024. 11230    INPUT ">  〃   住所は？＿",A
  1025. 11240    PRINT #1,A
  1026. 11250    INPUT ">  〃   名前は？＿",A
  1027. 11260    PRINT #1,A
  1028. 11270   CLOSE
  1029. 11280 RETURN
  1030. 11290 :
  1031.